home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / CD CHIP.ISO / WebServ / server7 / MapURL.dpr < prev    next >
Encoding:
Text File  |  1996-10-13  |  9.9 KB  |  249 lines
  1. Library MapURL;// Header conversion by Stephen Genusa <steveg@onramp.net> 06/08/96. Thanks!!! MWT
  2. Uses  SysUtils, Windows, Parser;
  3.  
  4. const    HTTP_FILTER_MAJOR          = 1; { major version of this spec }
  5.     HTTP_FILTER_MINOR          = 0; { minor version of this spec }
  6.     SF_MAX_USERNAME            = 257;
  7.     SF_MAX_PASSWORD            = 257;
  8.     SF_MAX_FILTER_DESC_LEN     = 257;
  9.  
  10.     // SF_STATUS_TYPE    SF_STATUS_TYPE                     = $8000000;  { base value }
  11.     SF_STATUS_REQ_FINISHED             = SF_STATUS_TYPE;
  12.     SF_STATUS_REQ_FINISHED_KEEP_CONN   = SF_STATUS_TYPE + 1;
  13.     SF_STATUS_REQ_NEXT_NOTIFICATION    = SF_STATUS_TYPE + 2;
  14.     SF_STATUS_REQ_HANDLED_NOTIFICATION = SF_STATUS_TYPE + 3;
  15.     SF_STATUS_REQ_ERROR                = SF_STATUS_TYPE + 4;
  16.     SF_STATUS_REQ_READ_NEXT            = SF_STATUS_TYPE + 5;
  17.     SF_NOTIFY_SECURE_PORT              = $00000001;
  18.     SF_NOTIFY_NONSECURE_PORT           = $00000002;
  19.     SF_NOTIFY_READ_RAW_DATA            = $00008000;
  20.     SF_NOTIFY_PREPROC_HEADERS          = $00004000;
  21.     SF_NOTIFY_AUTHENTICATION           = $00002000;
  22.     SF_NOTIFY_URL_MAP                  = $00001000;
  23.     SF_NOTIFY_SEND_RAW_DATA            = $00000400;
  24.     SF_NOTIFY_LOG                      = $00000200;
  25.     SF_NOTIFY_END_OF_NET_SESSION       = $00000100;
  26.     SF_NOTIFY_ORDER_HIGH               = $00080000;
  27.     SF_NOTIFY_ORDER_MEDIUM             = $00040000;
  28.     SF_NOTIFY_ORDER_LOW                = $00020000;
  29.     SF_NOTIFY_ORDER_DEFAULT            = SF_NOTIFY_ORDER_LOW;
  30.     SF_NOTIFY_ORDER_MASK               = (SF_NOTIFY_ORDER_HIGH or SF_NOTIFY_ORDER_MEDIUM or SF_NOTIFY_ORDER_LOW);
  31.  
  32.  
  33. type    PVOID = Pointer;    LPVOID = Pointer;
  34.     PCardinal = ^Cardinal;
  35.     SF_REQ_TYPE = (SF_REQ_SEND_RESPONSE_HEADER, SF_REQ_ADD_HEADERS_ON_DENIAL,
  36.                    SF_REQ_SET_NEXT_READ_SIZE, SF_REQ_SET_PROXY_INFO);
  37.  
  38.     TFuncPlaceHolder = POINTER;
  39.     THTTP_FILTER_CONTEXT = record      cbSize             : DWORD;
  40.       Revision           : DWORD;
  41.       ServerContext      : PVOID;
  42.       ulReserved         : DWORD;
  43.       fIsSecurePort      : BOOL;
  44.       pFilterContext     : PVOID;
  45.       GetServerVariable  : TFuncPlaceHolder; {TGetServerVariable;}
  46.       AddResponseHeaders : TFuncPlaceHolder; {TAddResponseHeaders;}
  47.       WriteClient        : TFuncPlaceHolder; {TWriteClient;}
  48.       AllocMen           : TFuncPlaceHolder; {TAllocMem;}
  49.       ServerSupportFunc  : TFuncPlaceHolder; {TServerSupportFunc;}
  50.     end;
  51.  
  52.     HTTP_FILTER_CONTEXT = THTTP_FILTER_CONTEXT;    PHTTP_FILTER_CONTEXT = ^HTTP_FILTER_CONTEXT;
  53.  
  54.     TGetServerVariable  = Function(var pfc          : THTTP_FILTER_CONTEXT;                                       VariableName : PChar;
  55.                                        Buffer       : PChar;
  56.                                        var BuffSize : DWORD) : BOOL; StdCall;
  57.  
  58.     TAddResponseHeaders = Function(var pfc          : THTTP_FILTER_CONTEXT;                                       Headers      : PChar;
  59.                                        Reserved     : DWORD) : BOOL; StdCall;
  60.  
  61.     TWriteClient        = Function(var pfc          : THTTP_FILTER_CONTEXT;                                       Buffer       : LPVOID;
  62.                                        dwBytes      : LPDWORD;
  63.                                        Reserved     : DWORD) : BOOL;  StdCall;
  64.  
  65.     TAllocMem           = Procedure(var pfc         : THTTP_FILTER_CONTEXT;                                        cbSize      : DWORD;
  66.                                         dwReserved  : DWORD); StdCall;
  67.  
  68.  
  69.     TServerSupportFunc = Function(var  pfc          : THTTP_FILTER_CONTEXT;                                       sfReq        : SF_REQ_TYPE;
  70.                                        pData        : PVOID;
  71.                                        ul1          : DWORD;
  72.                                        ul2          : DWORD) : BOOL; StdCall;
  73.  
  74.  
  75.     THTTP_FILTER_RAW_DATA = record      pvInData   : PVOID;
  76.       cbInData   : DWORD;
  77.       cbInBuffer : DWORD;
  78.       dwReserved : DWORD;
  79.     end;
  80.  
  81.     HTTP_FILTER_RAW_DATA  = THTTP_FILTER_RAW_DATA;    PHTTP_FILTER_RAW_DATA = ^HTTP_FILTER_RAW_DATA;
  82.  
  83.  
  84.     TGetHeader = Function(var pfc       : THTTP_FILTER_CONTEXT;                              lpszName  : PChar;
  85.                               lpvBuffer : LPVOID;
  86.                               lpdwSize  : LPDWORD) : BOOL; StdCall;
  87.  
  88.  
  89.     TSetHeader = Function(var pfc : THTTP_FILTER_CONTEXT;                              lpszName  : PChar;
  90.                               lpszValue : PChar) : BOOL; StdCall;
  91.  
  92.  
  93.     TAddHeader = Function(var pfc : THTTP_FILTER_CONTEXT;                              lpszName  : PChar;
  94.                               lpszValue : PChar) : BOOL; StdCall;
  95.  
  96.     THTTP_FILTER_PREPROC_HEADERS = record      GetHeader  : TGetHeader;
  97.       SetHeader  : TSetHeader;
  98.       AddHeader  : TAddHeader;
  99.       dwReserved : DWORD;
  100.     end;
  101.  
  102.     HTTP_FILTER_PREPROC_HEADERS  = THTTP_FILTER_PREPROC_HEADERS;    PHTTP_FILTER_PREPROC_HEADERS = ^HTTP_FILTER_PREPROC_HEADERS;
  103.  
  104.     THTTP_FILTER_AUTHENT = record      pszUser        : PChar;
  105.       cbUserBuff     : DWORD;
  106.       pszPassword    : PChar;
  107.       cbPasswordBuff : DWORD;
  108.     end;
  109.  
  110.     HTTP_FILTER_AUTHENT  = THTTP_FILTER_AUTHENT;    PHTTP_FILTER_AUTHENT = ^HTTP_FILTER_AUTHENT;
  111.  
  112.     THTTP_FILTER_URL_MAP = record      pszURL : PChar;
  113.       pszPhysicalPath : PChar;
  114.       cbPathBuff : DWORD;
  115.     end;
  116.  
  117.     HTTP_FILTER_URL_MAP  = THTTP_FILTER_URL_MAP;    PHTTP_FILTER_URL_MAP = ^HTTP_FILTER_URL_MAP;
  118.  
  119.     THTTP_FILTER_LOG = record
  120.       pszClientHostName : PChar;
  121.       pszClientUserName : PChar;
  122.       pszServerName     : PChar;
  123.       pszOperation      : PChar;
  124.       pszTarget         : PChar;
  125.       pszParameters     : PChar;
  126.       dwHttpStatus      : DWORD;
  127.       dwWin32Status     : DWORD;
  128.     end;
  129.  
  130.     HTTP_FILTER_LOG  = THTTP_FILTER_LOG;    PHTTP_FILTER_LOG = ^HTTP_FILTER_LOG;
  131.  
  132.     THTTP_FILTER_VERSION = record      dwServerFilterVersion : DWORD;
  133.       dwFilterVersion       : DWORD;
  134.       lpszFilterDesc        : array [0..(SF_MAX_FILTER_DESC_LEN-1)] of Char;
  135.       dwFlags               : DWORD;
  136.     end;
  137.  
  138.     HTTP_FILTER_VERSION = THTTP_FILTER_VERSION;    PHTTP_FILTER_VERSION = ^HTTP_FILTER_VERSION;
  139.  
  140.     TFilter=class     public      procedure AssignContext(var thisFC: HTTP_FILTER_CONTEXT);      function  GetServerVar(varName: String): String;     private      pFC: PHTTP_FILTER_CONTEXT;    end;// *******************// Start of code
  141. // *******************procedure TFilter.AssignContext(var thisFC: HTTP_FILTER_CONTEXT);begin  pFC:=@thisFC;end;function  TFilter.GetServerVar(varName: String): String;var  ss: ShortString;
  142.   buf: array[0..255] of char absolute ss;
  143.   len: Integer;
  144.   FNGetServerVariable: TGetServerVariable;
  145. begin
  146.   len:=255;
  147.   @FNGetServerVariable:=pFC^.GetServerVariable;
  148.   if FNGetServerVariable(pFC^, PChar(varName), Pointer(@buf[1]), len ) then
  149.   begin
  150.     ss[0]:=Char(len);
  151.     result:=ss;
  152.   end
  153.   else
  154.     Result:='<UNKNOWN>';
  155. end;Function GetFilterVersion(var pVer : HTTP_FILTER_VERSION) : BOOL; export; stdcall;begin
  156.   pVer.dwFilterVersion := MAKELONG(0, 1);
  157.   StrPCopy(pVer.lpszFilterDesc, 'Re-map URL version 0.2.');
  158.   pVer.dwFlags := (SF_NOTIFY_URL_MAP);
  159.   result := True;
  160. end;
  161.  
  162. function RemapURL(const url: String): String;
  163. var
  164.   f: TextFile;
  165.   bufLen: Integer;
  166.   path: String[255];
  167.   lineBuf: String;
  168.   inURL: String;
  169.   outURL: String;
  170. begin
  171.   Result:='';
  172.  
  173.   // Create a data file in the same directory the DLL itself resides.
  174.   bufLen:=GetModuleFileName( GetModuleHandle('MAPURL.DLL'), PChar(@path[1]), 255);
  175.   SetLength(path, bufLen);
  176.  
  177.   path:=ExtractFilePath(path)+'#urlmap.txt';
  178.  
  179.   // Create the file if it doesn't exist and load
  180.   // it with some demo info
  181.   if NOT FileExists(path) then
  182.   begin
  183.     AssignFile(f, path);
  184.     try
  185.      Rewrite(f);
  186.      Writeln(f, '; INURL OUTURL');
  187.      Writeln(f, '; remap.htm  c:\autoexec.bat    A request for remap.htm (in the server root) will send back your autoexec.bat file');
  188.      Writeln(f, ';');
  189.      Writeln(f, '; DELETE THIS NEXT LINE!!! It is for demo purposes only');
  190.      Writeln(f, 'remap.htm c:\autoexec.bat');
  191.      CloseFile(f);
  192.     except
  193.       ;
  194.     end;
  195.     exit;
  196.   end;
  197.  
  198.   AssignFile(f, path);
  199.   try
  200.     Reset(f);
  201.     try
  202.       while (not EOF(f)) do
  203.       begin
  204.          // Read a line
  205.          Readln(f, lineBuf);
  206.  
  207.          // Skip if it's a comment
  208.          if (Length(lineBuf)>0) AND (lineBuf[1]=';') then
  209.            continue;
  210.  
  211.          // Parse
  212.          inURL:=UpperCase(GetToken(lineBuf, 1, [' ']));
  213.          outURL:=UpperCase(GetToken(lineBuf, 2, [' ']));
  214.  
  215.          // Should we remap?
  216.          if Pos(inURL, url)=1 then
  217.          begin
  218.            Result:=outURL+Copy(url, Length(inURL)+1, 255);
  219.            break;
  220.          end;
  221.       end;
  222.     finally
  223.       CloseFile(f);
  224.     end;
  225.   except
  226.     ;
  227.   end;
  228.  
  229. end;
  230.  
  231.  
  232. Function HttpFilterProc(var pfc : HTTP_FILTER_CONTEXT; NotificationType : DWORD; pvNotification : LPVOID) : DWORD; export; stdcall;var  filter: TFilter;   function OnURLMap : DWORD;   var     mapStruct: PHTTP_FILTER_URL_MAP;     url: String;   begin     result := SF_STATUS_REQ_NEXT_NOTIFICATION;     mapStruct:=PHTTP_FILTER_URL_MAP(pvNotification);     // Extract the path info we need to try and map     url:=UpperCase( String(mapStruct.pszURL) );     // Does this map?     url:=RemapURL(url);     // If it maps, then copy it     if url<>'' then       StrCopy(mapStruct.pszPhysicalPath, PChar(url) );   end;
  233. begin  result:=SF_STATUS_REQ_NEXT_NOTIFICATION;  //Exit;  try    filter:=TFilter.Create;    filter.AssignContext(pfc);    Case NotificationType of      SF_NOTIFY_URL_MAP:      begin        result:=OnURLMap;      end;    end;
  234.     filter.Free;
  235.   except
  236.     ;
  237.   end;
  238. end;
  239.  
  240.  
  241.  
  242. exports
  243.   HttpFilterProc,
  244.   GetFilterVersion;
  245.  
  246.  
  247. end.
  248.  
  249.